#!/usr/bin/perl -w

#------------------------------------------------------------------------------
# Author:	Marelie Davel (marelie.davel@gmail.com)
#------------------------------------------------------------------------------

use strict;
use warnings;

my @required = ('prefix','suffix','ambifix','periphrasis','nulDeriv','clipping','variants','minSamples');

#-------------------------------------------------------------------------------

sub print_usage() {
  print "Usage: screen.pl <in:data> <in:spec> <out:data>\n";
  print "       <in:data>   = input data (wordform1 symbol wordform2)\n";
  print "       <in:spec>   = specification file to control data selected\n";
  print "       <out:data>  = selected output in same format as input\n";
}

#------------------------------------------------------------------------------
# Main functionality
#------------------------------------------------------------------------------

sub read_specs($\%) {
  my ($inName,$specP) = @_;
  open my $in, '<:encoding(utf8)', $inName or die "Cannot open $inName";
  while (<$in>) {
    chomp;
    next if /^\s*#/;
    next if /^\s*$/;
    $_ =~ s/#.*$//;
    $_ =~ s/\s*$//;
    my @parts = split /\s+/;
    if (scalar @parts != 2) {
      die "Error: wrong format file $inName line $_";
    }
    $specP->{$parts[0]} = $parts[1];
  }
  foreach my $r (@required) {
    if (!exists $specP->{$r}) {
      die "Error: please specify $r in specification file\n";
    }
  }
  if ($specP->{'prefix'}==1) {
    die "Error: Prefixation not yet implemented. Sorry.\n";
  }
  if ($specP->{'ambifix'}==1) {
    die "Error: Ambifixation not yet implemented. Sorry.\n";
  }
  if ($specP->{'variants'} eq 'proto') {
    die "Error: Prototypical variants not yet implemented. Sorry.\n";
  } else {
    my $val = $specP->{'variants'};
    if (!(($val eq 'first')||($val eq 'none'))) {
      die "Error: Unknown value $val for specification variable 'variants'.\n";
    }
  } 
}

#------------------------------------------------------------------------------

sub do_screen($$$) {
  my ($inName,$inSpecName,$outName)=@_;
  open my $in, '<:encoding(utf8)', $inName or die "Cannot open $inName";
  open my $out, '>:encoding(utf8)', $outName or die "Cannot open $outName";
  my %specs = ();
  read_specs($inSpecName,%specs);

  my %counts=();
  my %info=();
  my %wordInfo=();
  my %wordCounts=();
  while (<$in>) {
    chomp;
    my @parts = split /\t/;
    if (scalar @parts != 3) {
      die "Error: format error in input file: $_\n";
    }
    my $leftName = $parts[0];
    my $className = $parts[1];
    if ($specs{'prefix'}==1) {
      die "Error: Prefixation not yet implemented. Sorry.\n";
    } elsif ($specs{'prefix'}==0) {
      next if $className =~ /L/;
    }
    if ($specs{'ambifix'}==1) {
      die "Error: Ambifixation not yet implemented. Sorry.\n";
    } elsif ($specs{'ambifix'}==0) {
      next if $className =~ /L.*R/;
    }
    if ($specs{'suffix'}==0) {
      next if $className =~ /R/;
    }
    if ($specs{'periphrasis'}==0) {
      next if $className eq '(~)';
    }
    if ($specs{'nulDeriv'}==0) {
      next if $className eq '(=)';
    }
    if ($specs{'clipping'}==0) {
      next if $className =~ />$/;
    }
    if ($specs{'variants'} eq 'first') {
      next if exists $wordCounts{$leftName};
    }
    $info{$_}=$className;
    $counts{$className}++;
    $wordInfo{$_}=$leftName;
    $wordCounts{$leftName}++;
  }
  close $in;

  if ($specs{'variants'} eq 'none') {
    my @itemList = keys %info;
    foreach my $item (@itemList) {
      if (! exists $wordCounts{$wordInfo{$item}}) { 
        die "Error: unexpected event";
      }
      if ($wordCounts{$wordInfo{$item}} > 1) {
        $counts{$info{$item}}--;
        delete $info{$item};
      }
    }
  }  

  foreach my $item (sort keys %info) {
    if ($counts{$info{$item}}>=$specs{'minSamples'}) {
      print $out "$item\n";
    }
    #else {
    #  print "Skipping $info{$item} ($item)\n";
    #}
  }
}

#------------------------------------------------------------------------------

if (scalar @ARGV==3) {
  do_screen($ARGV[0],$ARGV[1],$ARGV[2]);
} else {
  print_usage();
  exit;
}

#------------------------------------------------------------------------------

